Introduction

Behavioural findings regarding the Illusion Game.

Methods

library(tidyverse)
library(ggdist)
library(ggside)
library(easystats)
library(patchwork)
library(brms)

df <- read.csv("data/study1.csv") |>
  mutate(
    Screen_Refresh = as.character(Screen_Refresh),
    Illusion_Side = as.factor(Illusion_Side),
    Block = as.factor(Block),
    Education = fct_relevel(Education, "Master", "Bachelor", "High School", "Other")
  )

Exclusions

outliers <- c(
  # Half of the trials are of very short RT
  # plot(estimate_density(dfraw[dfraw$Participant == "60684f29dbfe1bb2059e5e27_rkqoy", "RT"]))
  "60684f29dbfe1bb2059e5e27_rkqoy",
  # Error rate of 47.9%
  "61280140171ec546e87ed8cb_qdlgy",
  # Error rate of 46.2%
  "614f36fd81c78b7a125c4262_6ax4g",
  # Error rate of 42.1% and very large RT SD
  "5d398380b37ab1000111fac3_2nxxh",
  # Block n2 with very short RTs
  "5e860198a846e30497df5189_6e43s"
)

We removed 5 participants upon inspection of the average error rage (when close to 50%, suggesting random answers) and/or when the reaction time distribution was implausibly fast.

For each block, we computed the error rate and, if more than 50%, we discarded the whole block (as it likely indicates that instructions got mixed up, for instance participants were selecting the smaller instead of the bigger circle).

Error Rate

dfsub <- df |>
  group_by(Participant) |>
  summarize(
    # n = n(),
    Error = sum(Error) / n(),
    RT_Mean = mean(RT),
    RT_SD = sd(RT),
  ) |>
  ungroup() |>
  arrange(desc(Error))

knitr::kable(dfsub) |> 
  kableExtra::row_spec(which(dfsub$Participant %in% outliers), background  = "#EF9A9A")
Participant Error RT_Mean RT_SD
61280140171ec546e87ed8cb_qdlgy 0.479 262 296
614f36fd81c78b7a125c4262_6ax4g 0.462 630 611
5d398380b37ab1000111fac3_2nxxh 0.421 507 1679
5e860198a846e30497df5189_6e43s 0.402 492 725
61572ca3e91309ebe876a9db_8cqnp 0.287 659 333
5d9091ff391a60058a7711b5_dvz9e 0.269 578 172
6106b7157977b80c497314f8_d7ukm 0.260 718 1294
60684f29dbfe1bb2059e5e27_rkqoy 0.251 599 1326
611eb7284490ba01cddfbe98_om6zf 0.246 699 414
60d129f2a122e84175a56425_z2w8h 0.243 693 232
5d7389f193a945001a3ea504_nhua6 0.238 1160 1660
60dae077e62179eb469e32a4_b4pte 0.227 748 243
5c6b0a27ffc824000191c7d8_5ajt1 0.225 780 427
5ff46a1a99e7cfb2994f7958_f2zg0 0.216 506 150
5f19559b9665f700090276c4_hsmss 0.215 738 375
5c8ab0f10de08f00016e43a1_pyvgt 0.213 1076 557
6166a03f5063db088c458b73_m7w8f 0.207 804 378
606cd013f538ed55e02069b5_vr3v7 0.206 652 367
5f480e566265722a9b2b2660_0bola 0.205 511 147
605b60879326739b05897042_bpsyp 0.203 627 223
609193e5a0cea97bf00ac6e2_a6zcr 0.202 1133 982
610b0a1bf2434edb31592209_3f1wq 0.202 869 424
5f08583a3d61a604d606c517_o75t7 0.201 720 298
55eab7fd748092000daa98f2_f10fa 0.198 1110 738
5e04595a4fa02aefdb9c9ced_n3rey 0.189 983 830
61114f10ae21c59c0ed3d106_jw6v8 0.187 711 195
5f14886922a7d20725a22cde_9awyt 0.186 803 397
60a6dd8779e3de1097e5d50a_t4wyc 0.185 846 765
5c73e5d89b46930001ee7edc_ydo84 0.182 1045 1082
5e84f2663a34f20c3907e237_rt0oo 0.181 1001 562
5ebde9baaefecd1325ef23c7_lphsv 0.176 1307 1091
5d59a9d909f4300001de0c3b_l125y 0.175 1146 900
563bb259be9cac0005aab7ab_te1z4 0.174 703 243
60ba6031b6dde7c5b869bf74_gqplc 0.173 616 381
5dfae1f373d7248254527108_0rb1e 0.171 927 550
60b8e0ec34553723e3d6504d_ju18r 0.170 769 312
5d5051e31025380015dc59b8_dwrdh 0.157 848 364
60366cfe9748fc2b0ccbc9d0_ox8hj 0.156 712 383
5bce155e561901000121006f_49472 0.142 1109 863
5ccc3dd7a758ba00133c0763_lwl1g 0.139 895 816
5a0b46e0844c7a00015e4d13_jedw6 0.124 741 331
5eb0205cac7ad4085dc32a50_5xekt 0.092 884 509

Reaction Time

# RT distribution
estimate_density(df, select = "RT", at = c("Participant", "Block")) |>
  group_by(Participant) |>
  normalize(select = "y") |>
  ungroup() |>
  mutate(color = ifelse(Participant %in% outliers, "red", "blue")) |>
  ggplot(aes(x = x, y = y)) +
  geom_area(data = normalize(estimate_density(df, select = "RT"), select = "y"), alpha = 0.2) +
  geom_line(aes(color = color, group = interaction(Participant, Block), linetype = Block)) +
  geom_vline(xintercept = 2500, linetype = "dashed", color = "red") +
  scale_color_manual(values=c("red"="red", "blue"="blue"), guide = "none") +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  coord_cartesian(xlim = c(0, 3000)) +
  theme_modern() +
  theme(axis.text.y = element_blank()) +
  facet_wrap(~Participant) +
  labs(y = "", x = "Reaction Time (ms)")


# Filter out
df <- filter(df, !Participant %in% outliers)

Error Rate per Illusion Block

temp <- df |>
  group_by(Participant, Illusion_Type, Block) |>
  summarize(ErrorRate_per_block = sum(Error) / n()) |>
  ungroup() |> 
  arrange(desc(ErrorRate_per_block))

temp2 <- temp |> 
  filter(ErrorRate_per_block >= 0.5) |> 
  group_by(Illusion_Type, Block) |> 
  summarize(n = n()) |> 
  arrange(desc(n), Illusion_Type) |> 
  ungroup() |> 
  mutate(n_trials = cumsum(n * 56),
         p_trials = n_trials / nrow(df))

# knitr::kable(temp2)

p1 <- temp |>
  estimate_density(at = c("Illusion_Type", "Block")) |>
  ggplot(aes(x = x, y = y)) +
  geom_line(aes(color = Illusion_Type, linetype = Block)) + 
  geom_vline(xintercept = 0.5, linetype = "dashed") +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(y = "Distribution", x = "Error Rate") +
  theme_modern()

p2 <- temp2 |> 
  mutate(Block = fct_rev(Block)) |> 
  ggplot(aes(x = Illusion_Type, y = p_trials)) +
  geom_bar(stat="identity", aes(fill = Block)) +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(labels = scales::percent, expand = c(0, 0)) +
  labs(y = "Percentage of Trials Removed", x = "Illusion Type") +
  theme_modern()

p1 | p2



# Drop
df <- df |>
  group_by(Participant, Illusion_Type, Block) |>
  mutate(ErrorRate_per_block = sum(Error) / n()) |>
  ungroup() |> 
  filter(ErrorRate_per_block < 0.5) |>
  select(-ErrorRate_per_block)

rm(temp, temp2)

Participants

dfsub <- df |>
  group_by(Participant) |>
  select(Participant, Age, Sex, Education, Nationality, Ethnicity, Duration, Break_Duration, Screen_Resolution, Screen_Refresh, Device_OS) |>
  slice(1) |>
  ungroup()

37 participants (Mean age = 26.7, SD = 7.7, range: [19, 60]; Sex: 40.5% females, 54.1% males, 5.4% other; Education: Master, 21.62%; Bachelor, 32.43%; High School, 43.24%; Other, 2.70%)

plot_distribution <- function(dfsub, what = "Age", title = what, subtitle = "", fill = "orange") {
  dfsub |>
    ggplot(aes_string(x = what)) +
    geom_density(fill = fill) +
    geom_vline(xintercept = mean(dfsub[[what]]), color = "red", linetype = "dashed") +
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
    ggtitle(title, subtitle = subtitle) +
    theme_modern() +
    theme(
      plot.title = element_text(face = "bold", hjust = 0.5),
      plot.subtitle = element_text(face = "italic", hjust = 0.5),
      axis.title.x = element_blank(),
      axis.title.y = element_blank(),
      axis.text.y = element_blank()
    )
}

plot_waffle <- function(dfsub, what = "Nationality") {
  ggwaffle::waffle_iron(dfsub, what) |>
    # mutate(label = emojifont::fontawesome('fa-twitter')) |>
    ggplot(aes(x, y, fill = group)) +
    ggwaffle::geom_waffle() +
    # geom_point() +
    # geom_text(aes(label=label), family='fontawesome-webfont', size=4) +
    coord_equal() +
    ggtitle(what) +
    labs(fill = "") +
    theme_void() +
    theme(plot.title = element_text(face = "bold", hjust = 0.5))
}
p1 <- plot_distribution(dfsub, "Age", fill = "#FF9800")
p2 <- plot_distribution(dfsub, "Duration", title = "Total Duration", subtitle = "in minutes", fill = "#F44336")
p3 <- plot_distribution(dfsub, "Break_Duration", title = "Break Duration", subtitle = "in minutes", fill = "#3F51B5")

p4 <- plot_waffle(dfsub, "Sex") +
  scale_fill_manual(values = c("Male" = "#2196F3", "Female" = "#E91E63", "Other" = "#FF9800"))

p5 <- plot_waffle(dfsub, "Education") +
  scale_fill_viridis_d()

p6 <- plot_waffle(dfsub, "Nationality") +
  scale_fill_metro_d()

p7 <- plot_waffle(dfsub, "Ethnicity") +
  scale_fill_manual(values = c("Latino" = "#FF5722", "Asian" = "#FF9800", "Caucasian" = "#2196F3", "African" = "#4CAF50", "Jewish" = "#9C27B0"))

p8 <- plot_waffle(dfsub, "Screen_Resolution") +
  scale_fill_pizza_d()

p9 <- plot_waffle(dfsub, "Device_OS") +
  scale_fill_bluebrown_d()

# p10 <- plot_waffle(dfsub, "Screen_Refresh") +
#   scale_fill_viridis_d()


(p1 / p2 / p3) | (p4 / p5 / p6) | (p7 / p8 / p9)